home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / EMPPHONE.FRG < prev    next >
Text File  |  1990-06-16  |  5KB  |  224 lines
  1. * Program............: D:\DBSYS\CLASSES\BT4W\EMPPHONE.FRG
  2. * Date...............: 11-17-88
  3. * Versions...........: dBASE IV, Report 1
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap
  16.  
  17. *-- Test for no records found
  18. IF EOF() .OR. .NOT. FOUND()
  19.    RETURN
  20. ENDIF
  21.  
  22. *-- turn word wrap mode off
  23. _wrap=.F.
  24.  
  25. IF _plength < 12
  26.    SET DEVICE TO SCREEN
  27.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  28.    ACTIVATE WINDOW gw_report
  29.    @ 0,1 SAY "Increase the page length for this report."
  30.    @ 2,1 SAY "Press any key ..."
  31.    x=INKEY(0)
  32.    DEACTIVATE WINDOW gw_report
  33.    RELEASE WINDOW gw_report
  34.    RETURN
  35. ENDIF
  36.  
  37. _plineno=0          && set lines to zero
  38. *-- NOEJECT parameter
  39. IF gl_noeject
  40.    IF _peject="BEFORE"
  41.       _peject="NONE"
  42.    ENDIF
  43.    IF _peject="BOTH"
  44.       _peject="AFTER"
  45.    ENDIF
  46. ENDIF
  47.  
  48. *-- Set-up environment
  49. ON ESCAPE DO prnabort
  50. IF SET("TALK")="ON"
  51.    SET TALK OFF
  52.    gc_talk="ON"
  53. ELSE
  54.    gc_talk="OFF"
  55. ENDIF
  56. gc_space=SET("SPACE")
  57. SET SPACE OFF
  58. gc_time=TIME()      && system time for predefined field
  59. gd_date=DATE()      && system date  "    "    "     "
  60. gl_fandl=.F.        && first and last page flag
  61. gl_prntflg=.T.      && Continue printing flag
  62. gl_widow=.T.        && flag for checking widow bands
  63. gn_length=LEN(gc_heading)  && store length of the HEADING
  64. gn_level=2          && current band being processed
  65. gn_page=_pageno     && grab current page number
  66.  
  67.  
  68. *-- Initialize calculated variables.
  69. NAME=""
  70.  
  71. *-- Set up procedure for page break
  72. IF _pspacing > 1
  73.    gn_atline=_plength - (_pspacing + 1)
  74. ELSE
  75.    gn_atline=_plength - 2
  76. ENDIF
  77. ON PAGE AT LINE gn_atline EJECT PAGE
  78.  
  79. *-- Print Report
  80.  
  81. PRINTJOB
  82.  
  83. *-- Assign initial values to calculated variables.
  84. NAME=TRIM(LNAME)+', '+FNAME
  85.  
  86. IF gl_plain
  87.    ON PAGE AT LINE gn_atline DO Pgplain
  88. ELSE
  89.    ON PAGE AT LINE gn_atline DO Pgfoot
  90. ENDIF
  91.  
  92. DO Pghead
  93.  
  94. gl_fandl=.T.        && first physical page started
  95.  
  96. *-- File Loop
  97. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  98.    DO Upd_Vars
  99.    *-- Detail lines
  100.    IF .NOT. gl_summary
  101.       DO Detail
  102.    ENDIF
  103.    CONTINUE
  104. ENDDO
  105.  
  106. IF gl_prntflg
  107.    gl_fandl=.F.     && last page finished
  108.    IF _plineno <= gn_atline
  109.       EJECT PAGE
  110.    ENDIF
  111. ELSE
  112.    DO Reset
  113.    RETURN
  114. ENDIF
  115.  
  116. ON PAGE
  117.  
  118. ENDPRINTJOB
  119.  
  120. DO Reset
  121. RETURN
  122. * EOP: D:\DBSYS\CLASSES\BT4W\EMPPHONE.FRG
  123.  
  124. *-- Update summary fields and/or calculated fields in the detail band.
  125. PROCEDURE Upd_Vars
  126. NAME=TRIM(LNAME)+', '+FNAME
  127. RETURN
  128. * EOP: Upd_Vars
  129.  
  130. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  131. PROCEDURE prnabort
  132. gl_prntflg=.F.
  133. RETURN
  134. * EOP: prnabort
  135.  
  136. PROCEDURE Pghead
  137. ?
  138. IF .NOT. gl_plain
  139.    ?? "Page No." AT 0,
  140.    ?? _pageno PICTURE "999" AT 9
  141. ENDIF
  142. *-- Print HEADING parameter ie. REPORT FORM <name> HEADING <expC>
  143. IF .NOT. gl_plain .AND. gn_length > 0
  144.    ?? " "
  145.    ?? gc_heading FUNCTION "I;V"+;
  146.    LTRIM(STR(_rmargin-_lmargin-(_pcolno*2+2)))
  147. ENDIF
  148. IF .NOT. gl_plain
  149.    ?
  150. ENDIF
  151. IF .NOT. gl_plain
  152.    ?? gd_date AT 0
  153.    ?
  154. ENDIF
  155. ?
  156. ?? "EMPLOYEE PHONE LIST REPORT" AT 24
  157. ?
  158. ?
  159. ?? "     EMPID   DEPT      NAME" AT 0,
  160. ?? "PHONE" AT 52
  161. ?
  162. ?? ;
  163. "▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";
  164. + "▒";
  165. AT 0
  166. ?
  167. ?
  168. RETURN
  169. * EOP: Pghead
  170.  
  171.  
  172. PROCEDURE Detail
  173. IF 2 < _plength
  174.    IF gl_widow .AND. _plineno+1 > gn_atline
  175.       EJECT PAGE
  176.    ENDIF
  177. ENDIF
  178. ?? EMPID FUNCTION "T" AT 5,
  179. ?? DEPT FUNCTION "T" AT 13,
  180. ?? NAME FUNCTION "T" PICTURE "XXXXXXXXXXXXXXXXXXXXXXXX" AT 23,
  181. ?? PHONE FUNCTION "T" AT 52
  182. ?
  183. ?
  184. RETURN
  185. * EOP: Detail
  186.  
  187.  
  188. PROCEDURE Pgfoot
  189. PRIVATE _box
  190. gl_widow=.F.         && disable widow checking
  191. ?
  192. IF .NOT. gl_plain
  193. ENDIF
  194. EJECT PAGE
  195. *-- is the page number greater than the ending page
  196. IF _pageno > _pepage
  197.    GOTO BOTTOM
  198.    SKIP
  199.    gn_level=0
  200. ENDIF
  201. IF .NOT. gl_plain .AND. gl_fandl
  202.    DO Pghead
  203. ENDIF
  204. gl_widow=.T.         && enable widow checking
  205. RETURN
  206. * EOP: Pgfoot
  207.  
  208. *-- Process page break when PLAIN option is used.
  209. PROCEDURE Pgplain
  210. PRIVATE _box
  211. EJECT PAGE
  212. RETURN
  213. * EOP: Pgplain
  214.  
  215. *-- Reset dBASE environment prior to calling report
  216. PROCEDURE Reset
  217. SET SPACE &gc_space.
  218. SET TALK &gc_talk.
  219. ON ESCAPE
  220. ON PAGE
  221. RETURN
  222. * EOP: Reset
  223.  
  224.